home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 17 / examples / example.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1988-07-13  |  2.4 KB  |  74 lines
  1. (setq ship (Class 'new))    ; make a class known as ship
  2.  
  3. (ship 'ivars '(x y xv yv m name captain registry)) ; some instance variables
  4.  
  5. (ship 'answer 'getx        '() '( x ))    ; just evaluate x
  6. (ship 'answer 'getxv        '() '( xv ))    ; note that the method is a
  7. (ship 'answer 'gety        '() '( y ))    ; list of forms, the value
  8. (ship 'answer 'getyv        '() '( yv ))    ; of the last one being the
  9. (ship 'answer 'getm        '() '( m ))    ; value of the method
  10. (ship 'answer 'getname        '() '( name ))
  11. (ship 'answer 'getcaptain    '() '( captain ))
  12. (ship 'answer 'getregistry    '() '( registry ))
  13.  
  14. ;               formal
  15. ;               param
  16. ;               of
  17. ;               method
  18. (ship 'answer 'setx         '(to) '( (setq x to) ) )
  19. (ship 'answer 'setxv        '(to) '( (setq xv to) ) )
  20. (ship 'answer 'sety         '(to) '( (setq y to) ) )
  21. (ship 'answer 'setyv       '(to) '( (setq yv to) ) )
  22. (ship 'answer 'setm       '(to) '( (setq m to) ) )
  23. (ship 'answer 'setname     '(to) '( (setq name to) ) )
  24. (ship 'answer 'setcaptain  '(to) '( (setq captain to) ) )
  25. (ship 'answer 'setregistry '(to) '( (setq registry to) ) )
  26.  
  27. (ship 'answer 'sail '(time) 
  28.     ; the METHOD for sailing
  29.     '( (princ (list "sailing for " time " hours\n"))
  30.        ; note that this form is expressed in terms of objects:  "self"
  31.        ; is bound to the object being talked to during the execution
  32.        ; of its message.  It can ask itself to do things.
  33.        (self 'setx (+  (self 'getx)
  34.                (* (self 'getxv) time)))
  35.        ; This form performs a parallel action to the above, but more
  36.        ; efficiently, and in this instance, more clearly
  37.        (setq y (+ y (* yv time)))
  38.        ; Cute message for return value.  Tee Hee.
  39.        "Sailing, sailing, over the bountiful chow mein..."))
  40.  
  41. ; <OBJECT: #12345667> is not terribly instructive.  How about a more
  42. ; informative print routine?
  43.  
  44. (ship 'answer 'print '() '((princ (list
  45.                 "SHIP NAME: " (self 'getname) "\n"
  46.                 "REGISTRY: " (self 'getregistry) "\n"
  47.                 "CAPTAIN IS: " (self 'getcaptain) "\n"
  48.                 "MASS IS: " (self 'getm) " TONNES\n"
  49.                 "CURRENT POSITION IS: " 
  50.                     (self 'getx)    " X BY "
  51.                     (self 'gety)    " Y\n"
  52.                 "SPEED IS: "
  53.                     (self 'getxv)    " XV BY "
  54.                     (self 'getyv)    " YV\n") ) ))
  55.  
  56. ; a function to make life easier
  57.  
  58. (defun newship (mass name registry captain &aux new)
  59.     (setq new (ship 'new))
  60.     (new 'setx 0)
  61.     (new 'sety 0)
  62.     (new 'setxv 0)
  63.     (new 'setyv 0)
  64.     (new 'setm mass)
  65.     (new 'setname name)
  66.     (new 'setcaptain captain)
  67.     (new 'setregistry registry)
  68.     (new 'print)
  69.     new)
  70.  
  71. ; and an example object.
  72.  
  73. (setq Bounty (newship 50 'Bounty 'England 'Bligh))
  74.